home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0128_Percentage Status Bar.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  3KB  |  81 lines
  1.  
  2. {   I've seen a LOT of programs which Say they are doing something like
  3.     Reading/Writing to files, and you wonder if they have crashed or what,
  4.     I think it would be nice to have a nice Status Bar to show the progress
  5.     of what is going on!  so here's my contribution to everyone:
  6.     Statbar:  Highly Accurate Status Bar..  }
  7.  
  8. Uses crt;
  9. Procedure HideCursor; Assembler;  Asm                 {I forget where I got}
  10. MOV   ax,$0100;  MOV   cx,$2607;  INT   $10 end;    {     these two      }
  11.  
  12. Procedure ShowCursor; Assembler; Asm
  13. MOV   ax,$0100;  MOV   cx,$0506;  INT   $10 end;
  14.  
  15.  
  16.  
  17. Procedure Dupeit(Str: String; Num: Integer);  {Just a little Helper, dupes}
  18. var Cnt: integer;                             {        lines              }
  19. begin
  20. For Cnt := 1 to Num do begin
  21. write(Str);
  22. end;
  23. end;
  24.  
  25. Procedure Statbar(cnum,enum,xspot,yspot,fullcolor,emptycolor: Integer);
  26. var percentage: Integer;              {Uh-Oh, here comes the Mathematical}
  27. begin                                 {                Crap!!            }
  28. Hidecursor;                                 {Kill That Damned Cursor!}
  29. percentage := round(cnum / enum * 100 / 2);   {/2 can be changed for}
  30.   Gotoxy(xspot,yspot);                          {  Shorter Stat Bars  }
  31.  Textcolor(fullcolor);
  32. dupeit(#219,Percentage);                {Can change the Char to whatever}
  33.  Textcolor(emptycolor);
  34. dupeit(#177,50 - Percentage);                    {same as above}
  35.  
  36.   write('  ',percentage * 2,'%');         {this is not needed, just an extra}
  37. Showcursor;
  38. end;
  39.  
  40. Procedure WriteXy(x,y: Integer; dstr: String; tcolor: integer);
  41. Begin
  42. Hidecursor;
  43. Gotoxy(x,y);                      { Yeah, I now it's Cheap and cheezy}
  44. Textcolor(tcolor);                 { but it gets the job done well! }
  45. write(dstr);
  46. Showcursor;
  47. end;
  48.  
  49. var B1,B2,B3: integer;
  50.  
  51. Begin
  52.  
  53.   Clrscr;
  54.   WriteXy(30,3,'Statbar By CJ Cliffe..',yellow);
  55.  
  56. Repeat
  57.  
  58.  Inc(B1,1);
  59.  Inc(B2,1);
  60.  Inc(B3,1);
  61.  
  62. { The Statbar procedure works like so:
  63.  
  64. Statbar(Current Number, Final Number, x location, y location,
  65.                    Color of completed bars, color of empty bars);
  66.  
  67. Will process (as far as I know) Any pairs of numbers, as long as the Current
  68. Number does not exceed the Final Number, everything should look fine.. }
  69.  
  70.  
  71.    Statbar(B1,800,15,5,Lightcyan,Cyan);     {800 Just makes em go nice 'n}
  72.    Statbar(B2,800,15,7,LightRed,Red);       {slow because they are FAST  }
  73.    Statbar(B3,800,15,9,LightGreen,Green);
  74.  
  75. Until B1 = 800;
  76.  
  77.  WriteXy(30,15,'Press any key to quit...',Lightblue);
  78.  Readkey;
  79.  
  80. end.
  81.